home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / PUSHBU.ZIP;1 / PUSHBUTN.PRG < prev    next >
Encoding:
Text File  |  1993-06-13  |  14.6 KB  |  365 lines
  1. /*-------------------------------------------------------------------------*
  2.  
  3.              This program was adapted from the public domain work,
  4.                               RADIOBTN.PRG,
  5.                            by Dan Comeau, 1991
  6.  
  7.                        And the public domain work,
  8.                                PUSHBU.PRG,
  9.                           by Wendy Starbuck, 1992
  10.                       With modifications by Bango Rey
  11.  
  12.                                  NOTICE
  13.     PUSHBUTN.PRG, PUSHDEMO.CH, and PUSHDEMO.PRG were written by Wendy
  14.     Starbuck and placed into the public domain on 6/12/93.  The accompanying
  15.     PUSHDEMO.LIB was included for demonstration purposes only and all
  16.     copyrights are retained by the author, Wendy Starbuck.
  17.  
  18.  
  19. *--------------------------------------------------------------------------*
  20.  
  21.     Functions.:  PushBtnNew            Create push buttons
  22.                  DrawPushButtons       Draw all the push buttons
  23.                  PushBtnReader         Push button custom reader
  24.                  PushBtnKill           Kill the push button stack
  25.                  DispPushButton        Display an individual push button
  26.  
  27. *--------------------------------------------------------------------------*/
  28.  
  29. // Include standard headers
  30. #include "pushbutn.ch"                 // Pushbutton headers
  31. #include "box.ch"                      // Box frame constants
  32. #include "inkey.ch"                    // Keypress constants
  33. #include "setcurs.ch"                  // Cursor constants
  34. #include "getexit.ch"                  // Get system constants
  35.  
  36. // Define program constants
  37. #define HOT_BUTTON             .t.     // The button is in focus
  38. #define COLD_BUTTON            .f.     // The button is inactive
  39. #define ACTIVATE_BTNS          .t.     // Activate buttons, set focus
  40. #define DEACTIVATE_BTNS        .f.     // Deactivate buttons, kill focus
  41. #define BUTTON_PRESSED         .t.     // Button pressed indicator
  42. #define BUTTON_PASSED          .f.     // Button passed over indictor
  43.  
  44. // Get stack for push buttons
  45. static  aAllButtons := {}
  46.  
  47.  
  48. /*-------------------------------------------------------------------------*
  49.     Function..:  PushBtnNew     Initialization for Push Buttons
  50. *--------------------------------------------------------------------------*/
  51.  
  52. function PushBtnNew( oGet,           ; // Current get object
  53.                      nRow,           ; // Row coordinate
  54.                      nCol,           ; // Column coordinate
  55.                      nReturn,        ; // Return value
  56.                      nChoice,        ; // Starting choice
  57.                      aChoices        ) // Array of push button names
  58.  
  59.     // Declare work variables
  60.     local  x                           // pointer
  61.     local  y                           // pointer
  62.     local  lInit                       // initialization status indicator
  63.     local  cTrigger                    // button trigger keys
  64.     local  nTotButtons                 // total buttons in array
  65.  
  66.     // Declare color scheme variables
  67.     local  cColor                      // Window color string
  68.     local  cBarColor                   // Background bar color
  69.     local  cHotColor                   // Hot button color
  70.     local  cColColor                   // Cold button color
  71.  
  72.     // Kill the cursor
  73.     set cursor off
  74.  
  75.     // make sure nChoice is in valid range
  76.     nTotButtons := len( aChoices )
  77.     if nChoice < 1 .or. nChoice > nTotButtons
  78.         nChoice := 1
  79.     endif
  80.  
  81.     // Create the button color scheme
  82.     cColor     := oGet:ColorSpec
  83.     cBarColor  := "N" + substr(cColor,(x:= at("/", cColor)),at(",",cColor)-x)
  84.     cHotColor  := "W+/W"
  85.     cColColor  := "N/W"
  86.  
  87.     // Add choices array to the aAllButtons array.
  88.     aAdd( aAllButtons, { oGet:Name, aChoices, ;
  89.                          cBarColor + ";" + cHotColor + ";" + cColColor } )
  90.  
  91.     // draw the buttons
  92.     DrawPushButtons( nRow, nCol,                           ;
  93.                      aChoices, nTotButtons, nChoice,       ;
  94.                      cBarColor, cHotColor, cColColor,      ;
  95.                      BUTTON_PASSED, DEACTIVATE_BTNS        )
  96.  
  97. return NIL
  98.  
  99.  
  100. /*-------------------------------------------------------------------------*
  101.     Function..:  DrawPushButtons  Draw push buttons.
  102. *--------------------------------------------------------------------------*/
  103.  
  104. static function DrawPushButtons(     ;
  105.                         nRow,        ; // Row coordinate
  106.                         nCol,        ; // Column coordinate
  107.                         aChoices,    ; // Array of button names
  108.                         nTotButtons, ; // Total buttons in array
  109.                         nInFocus,    ; // Starting choice
  110.                         cBarColor,   ; // Background bar color
  111.                         cHotColor,   ; // Hot button color
  112.                         cColColor,   ; // Cold button color
  113.                         lBtnPressed, ; // Button pressed or static
  114.                         lActivate    ) // Buttons are active or deselected
  115.  
  116.     // Declare work variables
  117.     local nActive       := 0           // Active choice
  118.     local nBtnOffset    := 0           // Button offset
  119.     local nPusPopOffset := 0           // Push/Pop offset
  120.     local x             := 0           // counter
  121.  
  122.     // Handle defaults
  123.     lBtnPressed := if( valtype( lBtnPressed ) == "L", lBtnPressed, .F. )
  124.     lActivate   := if( valtype( lActivate ) == "L", lActivate, .T. )
  125.  
  126.     // Display all the buttons
  127.     DispBegin()
  128.     for nActive = 1 to nTotButtons
  129.  
  130.         SetColor( cBarColor )
  131.         if nActive <= nTotButtons
  132.             if nInFocus == nActive
  133.                 DispPushBtn( nRow, nCol, nBtnOffset, ;
  134.                              if( lActivate, HOT_BUTTON, COLD_BUTTON), ;
  135.                              aChoices[nActive], cHotColor, lBtnPressed )
  136.                 nPusPopOffset := nBtnOffset
  137.             else
  138.                 DispPushBtn( nRow, nCol, nBtnOffset, ;
  139.                              COLD_BUTTON, aChoices[nActive], cColColor )
  140.             endif
  141.             nBtnOffset += ( len( aChoices[nActive] ) + 4 )
  142.         endif
  143.  
  144.     next
  145.     DispEnd()
  146.  
  147.     // Handle pop-out action if the button was pushed
  148.     if lBtnPressed
  149.         Inkey(.2)
  150.         SetColor( cBarColor )
  151.         DispPushBtn( nRow, nCol, nPusPopOffset, ;
  152.                      HOT_BUTTON, aChoices[nInFocus], cHotColor, .F. )
  153.         Inkey(.1)
  154.     endif
  155.  
  156. return NIL
  157.  
  158.  
  159. /*-------------------------------------------------------------------------*
  160.     Function..:  PushBtnReader
  161. *--------------------------------------------------------------------------*/
  162.  
  163. function PushBtnReader( oGet )
  164.  
  165.     // Declare work variables
  166.     local aChoices                     // push button choices
  167.     local nMaxChoices                  // max number of choices
  168.     local nChoice                      // button choices (1st one is name of get variable)
  169.     local nOldChoice                   // to save current choice
  170.     local cGetVar                      // current get variable
  171.     local cSavedScreen                 // to save portion of screen normally showing GET value
  172.     local cTrigger                     // button trigger keys
  173.     local nKey          := 0           // key pressed
  174.     local n             := 0           // temp variable
  175.     local x             := 0           // temp variable
  176.  
  177.     // Declare color scheme variables
  178.     local cColor                       // Color string
  179.     local cBarColor                    // Background bar color
  180.     local cHotColor                    // Hot button color
  181.     local cColColor                    // Cold button color
  182.  
  183.     // initialize choices
  184.     aChoices   := aAllButtons[ascan(aAllButtons, { |a| a[1] == oGet:Name }),2]
  185.     nChoice    := oGet:VarGet()
  186.     nMaxChoices:= len( aChoices )
  187.  
  188.     // initialize color scheme
  189.     cColor     := aAllButtons[ascan(aAllButtons, { |a| a[1] == oGet:Name }),3]
  190.     cBarColor  := substr( cColor, 1, at( ";", cColor)-1 )
  191.     cHotColor  := substr( cColor, (x := at(";",cColor)+1), rat(";",cColor)-x )
  192.     cColColor  := substr( cColor, rat(";",cColor)+1 )
  193.     
  194.     // activate the GET for reading
  195.     dispbegin()
  196.  
  197.     // save the 1 character spot where the GET value is about to be displayed
  198.     cSavedScreen := savescreen( oGet:row, oGet:col, oGet:row, oGet:col )
  199.     oGet:SetFocus()
  200.  
  201.     // restore the 1 character spot where the GET displayed its value
  202.     restscreen( oGet:row, oGet:col, oGet:row, oGet:col, cSavedScreen )
  203.  
  204.     // draw the buttons
  205.     DrawPushButtons( oGet:Row, oGet:Col,                                  ;
  206.                      aChoices, nMaxChoices, nChoice,                      ;
  207.                      cBarColor, cHotColor, cColColor,                     ;
  208.                      BUTTON_PASSED, ACTIVATE_BTNS                         )
  209.     dispend()
  210.  
  211.     oGet:exitState := GE_NOEXIT
  212.     while ( oGet:exitState == GE_NOEXIT )
  213.  
  214.         nOldChoice := nChoice      // save "old" choice before movement
  215.  
  216.         nKey := Inkey(0)    
  217.     
  218.         // determine what key was pressed
  219.         do case
  220.         case nKey == K_ESC    ; oGet:ExitState := GE_ESCAPE
  221.         case nKey == K_ENTER  ; oGet:ExitState := GE_ENTER
  222.         case nKey == K_SPACE  ; oGet:ExitState := GE_ENTER
  223.         case nKey == K_UP     ; oGet:ExitState := GE_UP
  224.         case nKey == K_DOWN   ; oGet:ExitState := GE_DOWN
  225.         case nKey == K_LEFT   ; nChoice := if(nChoice==1,nMaxChoices,nChoice-1)
  226.         case nKey == K_RIGHT  ; nChoice := if(nChoice==nMaxChoices,1,nChoice+1)
  227.         case nKey == K_TAB
  228.             if nChoice == nMaxChoices
  229.                 oGet:ExitState := GE_DOWN
  230.             else
  231.                 nChoice++
  232.             endif
  233.         case nKey == K_SH_TAB
  234.             if nChoice == 1
  235.                 oGet:ExitState := GE_UP
  236.             else
  237.                 nChoice--
  238.             endif
  239.         otherwise
  240.             // handle if user pressed a key to select the first letter
  241.             // 1st, continue search from current location
  242.             n := ascan( aChoices,                                         ;
  243.                         { |c| upper(left(alltrim(c),1)) ==                ;
  244.                               upper(chr(nKey)) },                         ;
  245.                         nChoice+1, nMaxChoices                            )
  246.             if n == 0
  247.                 // 2nd, if another not found, restart search from the top
  248.                 n := ascan( aChoices,                                     ;
  249.                             { |c| upper(left(alltrim(c),1)) ==            ;
  250.                                   upper(chr(nKey)) },                     ;
  251.                             1, nChoice - 1                                )
  252.             endif
  253.             nChoice := if( n > 0, n, nChoice )   
  254.         endcase
  255.  
  256.         // check if moved to new push button selection
  257.         if ! nOldChoice == nChoice
  258.             DrawPushButtons( oGet:Row, oGet:Col,                          ;
  259.                              aChoices, nMaxChoices, nChoice,              ;
  260.                              cBarColor, cHotColor, cColColor,             ;
  261.                              BUTTON_PASSED, ACTIVATE_BTNS                 )
  262.         endif
  263.  
  264.     enddo
  265.     
  266.     oGet:VarPut( nChoice )
  267.     dispbegin()
  268.  
  269.     // save the 1 character spot where the GET value is about to be displayed
  270.     cSavedScreen := savescreen( oGet:row, oGet:col, oGet:row, oGet:col )
  271.     oGet:KillFocus()
  272.  
  273.     // restore the 1 character spot where the GET displayed its value
  274.     restscreen( oGet:row, oGet:col, oGet:row, oGet:col, cSavedScreen )
  275.     dispend()
  276.  
  277.     if nKey == K_ENTER .or. nKey == K_SPACEBAR
  278.         // If button pushed, then make it look like you pushed the darn thing
  279.         DrawPushButtons( oGet:Row, oGet:Col,               ;
  280.                          aChoices, nMaxChoices, nChoice,   ;
  281.                          cBarColor, cHotColor, cColColor,  ;
  282.                          BUTTON_PRESSED, ACTIVATE_BTNS     )
  283.     else
  284.         // otherwise, deselect the buttons
  285.         DrawPushButtons( oGet:Row, oGet:Col,               ;
  286.                          aChoices, nMaxChoices, nChoice,   ;
  287.                          cBarColor, cHotColor, cColColor,  ;
  288.                          BUTTON_PASSED, DEACTIVATE_BTNS    )
  289.     endif
  290.  
  291. return NIL
  292.  
  293.  
  294. /*-------------------------------------------------------------------------*
  295.     Function..:  PushBtnKill
  296. *--------------------------------------------------------------------------*/
  297.  
  298. function PushBtnKill()
  299.     aAllButtons := {}
  300. return nil
  301.  
  302.  
  303. /*-------------------------------------------------------------------------*
  304.     Function..:  DispPushBtn    Button - push button style.
  305. *--------------------------------------------------------------------------*/
  306.  
  307. static function DispPushBtn( nRow, nCol, nBtnOffset, ;
  308.                              lHotButton, cName, cColor, lBtnPressed )
  309.  
  310.     // Declare work variables
  311.     local  nLen
  312.     local  cPointer1
  313.     local  cPointer2
  314.  
  315.     // Handle defaults
  316.     lHotButton := if( valtype( lHotButton ) == "L", lHotButton, .F. )
  317.     lBtnPressed:= if( valtype( lBtnPressed ) == "L", lBtnPressed, .F. )
  318.     nLen       := len( cName )
  319.     nCol       := nCol + nBtnOffset
  320.     cColor     := if( cColor == NIL, SetColor(), cColor )
  321.     cPointer1  := if( lHotButton, chr(16), " " )
  322.     cPointer2  := if( lHotButton, chr(17), " " )
  323.  
  324.     if lBtnPressed
  325.         @ nRow,   nCol   say space( nLen + 3 )
  326.         @ nRow+1, nCol   say space( nLen + 3 )
  327.         SetColor( cColor )
  328.         @ nRow,   nCol+1 say cPointer1 + cName + cPointer2
  329.     else
  330.         @ nRow,   nCol+nLen+2 say "‹"
  331.         @ nRow+1, nCol+1 say Replicate( "fl", nLen + 2 )
  332.         SetColor( cColor )
  333.         @ nRow,   nCol+0 say cPointer1 + cName + cPointer2
  334.     endif
  335.  
  336. return NIL
  337.  
  338.  
  339. /*-------------------------------------------------------------------------*
  340.     Function..:  DispPushBox     Button - box style.
  341. *--------------------------------------------------------------------------*/
  342.  
  343. static function DispPushBox( nRow, nCol, nBtnOffset, ;
  344.                              lHotButton, cName, cColor, lBtnPressed )
  345.  
  346.     local nLen := Len( cName )
  347.  
  348.     cColor := if( cColor == NIL, SetColor(), cColor )
  349.     lBtnPressed  := if( lBtnPressed == NIL, .F., lBtnPressed )
  350.     nCol := nCol + nBtnOffset
  351.  
  352.     if lHotButton .and. ! lBtnPressed
  353.         @ nRow+0, nCol+0, nRow+2, nCol+nLen+4 box "⁄ƒ∑∫ºÕ‘≥"
  354.         SetColor( cColor )
  355.         @ nRow+1, nCol+2  say cName
  356.     else
  357.         @ nRow+0, nCol+0, nRow+2, nCol+nLen+4 box B_SINGLE
  358.         @ nRow+1, nCol+2  say cName
  359.     endif
  360.  
  361. return NIL
  362.  
  363.  
  364. /* EOF: SWISPBTN.PRG -----------------------------------------------------*/
  365.